home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lantools / blueprnt / bpdebug.pas < prev    next >
Pascal/Delphi Source File  |  1990-01-03  |  3KB  |  106 lines
  1. program set_time_from_server;
  2. (*************************************************************
  3. * Set Time using Time on Specifed Server                     *
  4. * by Craig Chaiken                  (BPTIME.PAS, BPTIME.EXE) *                             *
  5. * October 3, 1989                                            *
  6. *                                                            *
  7. * Function:                                                  *
  8. *     This program reads the number of ticks since midnight, *
  9. *     a 32 bit number at location 0000:046C, from the        *
  10. *     server, and set this client to match.                  *
  11. *                                                            *
  12. * Command Format:                                            *
  13. *     BPTIME /socket_number                                  *
  14. *************************************************************)
  15. uses dos;
  16. {$I bppascal.inc}
  17. var
  18.     temp:integer;i:word;
  19.     high_nibble,low_nibble:byte;
  20.     command:string;
  21.  
  22. function hexbyte(decimal:byte):string;
  23. var s:string;
  24. begin
  25.     s:='';
  26.     high_nibble:=(decimal shr 4) and $f;
  27.     low_nibble:=(decimal and $f);
  28.     if high_nibble > 9 then high_nibble:=high_nibble+7;
  29.     if low_nibble > 9 then low_nibble:=low_nibble+7;
  30.     s:=s+chr(ord('0')+high_nibble);
  31.     s:=s+chr(ord('0')+low_nibble);
  32.     hexbyte:=s;
  33. end;
  34.  
  35. function hexword(decimal:word):string;
  36. var    s:string;
  37. begin
  38.     s:=hexbyte(hi(decimal))+hexbyte(lo(decimal));
  39.     hexword:=s
  40. end;
  41.  
  42. function get_command:string;
  43. var s:string;
  44. begin
  45.     write ('-');
  46.     readln(s);
  47.     s[1]:=upcase(s[1]);
  48.     for i:=2 to length(s) do
  49.      begin
  50.         s[i]:=upcase(s[i]);
  51.         if s[i]>'9' then s[i]:=chr(ord(s[i])-7);
  52.         s[i]:=chr(ord(s[i])-48)
  53.     end;
  54.     get_command:=s
  55. end;
  56.  
  57. procedure build_packet;
  58. var    j:integer;
  59. begin
  60.     packet_length:=1;
  61.     j:=2;
  62.     while j<length(command) do
  63.     begin
  64.         packet_buffer[packet_length]:=ord(command[j]) shl 4
  65.         +ord(command[j+1]);
  66.         j:=j+2;
  67.         inc(packet_length)
  68.     end;
  69.     packet_buffer[0]:=ord(command[1]) or byte($20);
  70. end;
  71.  
  72.  
  73. begin
  74.     socket_number:=get_opt(1);
  75.     command:='Start';
  76.     while command[1]<>'Q' do
  77.     begin
  78.         command:=get_command;
  79.         case command[1] of
  80.         'R','I':
  81.             begin
  82.                 build_packet;
  83.                 put_packet(socket_number);
  84.                 packet_length:=get_packet(socket_number);
  85.                 for i:=1 to packet_length-1 do
  86.                     write(hexbyte(packet_buffer[i]));
  87.                 writeln;
  88.                 for i:=1 to packet_length-1 do
  89.                     if packet_buffer[i]>31 then
  90.                         write(chr(packet_buffer[i]))
  91.                     else
  92.                         write('.');;
  93.                 writeln;
  94.  
  95.             end;
  96.         'W','O','F','M','E':
  97.             begin
  98.                 build_packet;
  99.                 put_packet(socket_number);
  100.             end;
  101.         'Q':writeln('Quit');
  102.         else writeln('Invalid Debugger Command!');
  103.     end;
  104.     end;
  105. end.
  106.